Optional Drawing.f

{ Notes

Currently the circle vertices are precalculated in a VBO, while lines and rectangles are done dynamically in client memory.
Switching between drawing circles and other VBO-based things like text and client-memory-based things has a performance penalty. This is how things just are at the moment.

}

Requires OPENGL
Requires FixedPoint
Requires Tools
Requires GL-Tools
Requires SORA\Transformations
Requires SORA\Vbufs

Only Forth Definitions

Variable pencolor

0 Value stride

Create pen  8 2* /allot

pen Constant drawarray

: @pen   pen 2h@ ;

: bgra<>rgba
   dup 16 rshift $ff and   ( rgba b )
   over $ff and 16 lshift  ( rgba b 00r0 )
   rot $ff00ff00 and or or ;

: draw-color   ( draw-color -- )
   pencolor <>:[ drop pencolor glColor4ubv ;] ;

: enable-vertex-array  (  -- )
   glEnableClientState( GL_VERTEX_ARRAY ) ;

: disable-vertex-array
   glDisableClientState( GL_VERTEX_ARRAY ) ;

: enable-color-array  (  -- )
\   >r 4 GL_UNSIGNED_BYTE stride r> glColorPointer
   glEnableClientState( GL_COLOR_ARRAY ) ;

: disable-color-array
   glDisableClientState( GL_COLOR_ARRAY ) ;

: enable-normal-array  (  -- )
\   GL_FLOAT stride rot glNormalPointer
   glEnableClientState( GL_NORMAL_ARRAY ) ;

: disable-normal-array
   glDisableClientState( GL_NORMAL_ARRAY ) ;

: enable-texture-array (  -- )
\   >r 2 GL_FLOAT stride r> glTexCoordPointer
   glEnableClientState( GL_TEXTURE_COORD_ARRAY ) ;

: disable-texture-array
   glDisableClientState( GL_TEXTURE_COORD_ARRAY ) ;

\ Enable/disable each of the arrays in one call.
\   texture, normal, color
: enable-TNC   ( flag flag flag -- )
   if enable-color-array else disable-color-array then
   if enable-normal-array else disable-normal-array then
   if enable-texture-array else disable-texture-array then ;

: draw-arrays2d  (  array  format  length  type -- )
   locals| type  length  format  array |
   glVertexPointer( 2  format  stride  array )
   enable-vertex-array
   gldrawarrays( type 0 length ) ;

: draw-arrays3d  (  array  format  length  type -- )
   locals| type  length  format  array |
   glVertexPointer(  3  format  stride  array )
   enable-vertex-array
   gldrawarrays( type 0 length ) ;

: begin-draw
   unbind-vbo
   0 0 0 enable-tnc
   gl-texture gl-disable ;

: at   ( x y -- )
   pen 2h!  ;

: +at   ( x y -- )
   pen 2 + h+!   pen h+! ;

: at3D   ( x y z -- )
   pen 4 + h!  pen 2 + h!  pen h! ;

: +at3D   ( x y z -- )
   pen 4 + h+!  pen 2 + h!  pen h! ;

: (line)
   begin-draw
   drawarray 6 + h!
   drawarray 4 + h!
   drawarray GL_SHORT 2 GL_LINES draw-arrays2D ;

: line  ( x2 y2 color -- )
   draw-color (line) ;

: line3D  ( x2 y2 z2 color -- )
   draw-color
   begin-draw
   drawarray 10 + h!
   drawarray 8 + h!
   drawarray 6 + h!
   drawarray GL_SHORT 2 GL_LINES draw-arrays3D ;

{
: draw-elements2  (  type  array  ref-array   format  length  -- )
   locals| length format ref array type |
   GL_VERTEX_ARRAY glEnableClientState
   2 format vert-stride @ array glVertexPointer
   type length 0 ref glDrawElements
   reset-state ;

: draw-elements3  (  type  array  ref-array   format  length  -- )
   locals| length format ref array type |
   GL_VERTEX_ARRAY glEnableClientState
   3 format vert-stride @ array glVertexPointer
   type length 0 ref glDrawElements
   reset-state ;
}


: interleaved ( bytes -- )
   to stride ;

: packed  ( -- )
   0 to stride ;


\ Colors

: makes:   ( rgb -- <name>) ( -- color )
   bgra<>rgba   $ff000000 or -? constant ;

HEX

000000 makes: BLACK              404040 makes: DKGREY
808080 makes: GREY               B0B0B0 makes: LTGREY
FFFFFF makes: WHITE              F8F8B8 makes: BEIGE
FF80FF makes: PINK               FF0000 makes: RED
800000 makes: DKRED              FF8000 makes: ORANGE
804000 makes: BROWN              FFFF00 makes: YELLOW
808000 makes: DKYELLOW           80FF00 makes: NEON
00FF00 makes: GREEN              008000 makes: DKGREEN
00FFFF makes: CYAN               008080 makes: DKCYAN
0000FF makes: BLUE               000080 makes: DKBLUE
8080FF makes: LTBLUE             8000FF makes: VIOLET
400080 makes: DKVIOLET           FF00FF makes: MAGENTA
800080 makes: DKMAGENTA          FFFF80 makes: LTYELLOW
E0E080 makes: KHAKI
8000FF makes: PURPLE             400080 makes: DKPURPLE

:macro a   ( rgb a -- rgba )   24 lshift swap $ffffff and or ;

DECIMAL


{ =================
   0,1 --> 2,3
            |
            V
   6,7 <-- 4,5
================= }

: rect  ( w h color -- )
   draw-color
   begin-draw
     drawarray 1 h[] h@ dup drawarray 3 h[] h!
      1 - + dup drawarray 5 h[] h! drawarray 7 h[] h!
     drawarray h@ dup drawarray 6 h[] h!
      1 - + dup drawarray 2 h[] h! drawarray 4 h[] h!
   drawarray GL_SHORT 4 GL_LINE_LOOP draw-arrays2d ;

: rectf  ( w h color -- )
   draw-color
   begin-draw
   drawarray 1 h[] h@ dup drawarray 3 h[] h!
      + dup drawarray 5 h[] h! drawarray 7 h[] h!
   drawarray h@ dup drawarray 6 h[] h!
      + dup drawarray 2 h[] h! drawarray 4 h[] h!
   drawarray GL_SHORT 4 GL_QUADS draw-arrays2d ;

: oval-vertices  ( radiusx radiusy resolution -- )
   dup 0 do
      3dup  i  360.0  rot */  ellipse-point point2D
   loop  3drop ;

2D-Points 0 Vbuf: circle-vbuf    \ 1025 vertices
2D-Points 0 Vbuf: lores-circle-vbuf  \ 65 vertices

: init-circle
   100 circle-vbuf vertices:[  32767 32767 100 oval-vertices  ;]
   24 lores-circle-vbuf vertices:[  32767 32767 24 oval-vertices  ;] ;

: small-enough?
   50 <= swap 50 <= or ;

: (draw-oval)  ( r1 r2 ptype -- )
   begin-draw
   >r
   push-modelview
      pen 2h@ 2s>f 0.05e f+ 0e glTranslatef
      2dup swap .>f f2* .>f f2* 1e glScalef
      small-enough? if lores-circle-vbuf else circle-vbuf then
      r> over ->ptype !
      draw
   pop-modelview ;

: oval  ( r1 r2 color -- )
   draw-color   1 dup 2+  GL_LINE_LOOP (draw-oval) ;

: ovalf   ( r1 r2 color -- )
   draw-color   ( 1 dup 2+ ) GL_TRIANGLE_FAN (draw-oval) ;

: circle   >r dup r> oval ;
: circlef   >r dup r> ovalf ;

: dot   ( color -- )
   draw-color   drawarray GL_SHORT 2 GL_POINTS draw-arrays2d ;


: grid  ( spacingx spacingy cols rows color -- )
   draw-color
   locals| rows cols spacingy spacingx |
   @pen
   rows 1 + 0 do
      @pen cols spacingx * 1 + 0 2+ (line)
      0 spacingy +at
   loop
   2dup at
   cols 1 + 0 do
      @pen 0 rows spacingy * 2+ (line)
      spacingx 0 +at
   loop
   at ;

Requires SORA\Text-display

:[] text:[ ( font color xt -- ) ( -- )
   swap text-transform ->color !
   pen 2h@ text-transform ->x 2v!
   swap begin-text 4096 text-vbuf rot text-vertices
   text-vbuf 0 text-count 4 * draw-some ;

: text  ( string count color -- )
   text-transform ->color !
   pen 2h@ text-transform ->x 2v!
   font begin-text locals| cnt string |
   cnt 4 * text-vbuf draw:[ string cnt (gtype) ;] ;


\ Color manipulation
-? variable c1
-? variable c2

: red@   2 + c@ ;     : red!   2 + c! ;       : red+!   2 + c+! ;
: green@   1 + c@ ;   : green!   1 + c! ;     : green+!   1 + c+! ;
: blue@   c@ ;        : blue!   c! ;          : blue+!   c+! ;
: alpha@   3 + c@ ;   : alpha!   3 + c! ;     : alpha+!   3 + c+! ;

: mix  ( color color n. -- color )
   locals| n |
   c2 ! c1 !
   c1 red@ c2 red@ n lerp c1 red!
   c1 green@ c2 green@ n lerp c1 green!
   c1 blue@ c2 blue@ n lerp c1 blue!
   c1 alpha@ c2 alpha@ n lerp c1 alpha!
   c1 @ ;

: init-drawing
   init-circle ;
